home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / modula2 / module / cookieja.mod < prev    next >
Encoding:
Modula Implementation  |  1995-11-25  |  6.5 KB  |  219 lines
  1. IMPLEMENTATION MODULE  CookieJar;
  2.  
  3. FROM SYSTEM IMPORT ADDRESS,VAL,TSIZE;
  4. FROM MACHINE IMPORT SuperOn,SuperOff;
  5. FROM InOut IMPORT WriteString,WriteLn;
  6. FROM LongInOut IMPORT WriteLongCard;
  7.  
  8. (*TYPE Cookie = RECORD
  9.                   CookieId : ARRAY [0..3] OF CHAR;
  10.                   CookieValue : LONGCARD;
  11.               END(*RECORD*);*)
  12.  
  13. PROCEDURE CreateCookie(VAR cookie:Cookie; id : ARRAY OF CHAR;
  14.                        value: LONGCARD );
  15. (* Initialisiert in der Variablen cookie einen Cookie;
  16.    als weitere Parameter werden die Id des Coockies sowie
  17.    dessen Wert übergeben *)
  18. BEGIN
  19.    cookie.CookieId[0]:=id[0];
  20.    cookie.CookieId[1]:=id[1];
  21.    cookie.CookieId[2]:=id[2];
  22.    cookie.CookieId[3]:=id[3];
  23.    cookie.CookieValue:=value;
  24. END CreateCookie;
  25.  
  26. PROCEDURE ccmp(c1,c2:Cookie):BOOLEAN;
  27. (* Nur um nicht StrCompare IMPORTieren zu müssen*)
  28. BEGIN
  29.    IF (c1.CookieId[0]=c2.CookieId[0]) AND
  30.       (c1.CookieId[1]=c2.CookieId[1]) AND
  31.       (c1.CookieId[2]=c2.CookieId[2]) AND
  32.       (c1.CookieId[3]=c2.CookieId[3]) THEN
  33.        RETURN TRUE
  34.    ELSE
  35.        RETURN FALSE
  36.    END(*IF*);
  37. END ccmp;
  38.  
  39. PROCEDURE NewCookie(VAR Entry:Cookie):BOOLEAN;
  40. (* Trägt einen Neuen Cookie in den Jar ein.
  41.    Achtung !
  42.    Der Fall eines bereits vollen Jars wird hier nicht
  43.    abgefangen. Es muss dann entsprechend Speicher ALLOCATEed
  44.    und der ganze Jar umkopiert werden *)
  45. TYPE CookieJar = POINTER TO Cookie;
  46. VAR cookieJar, cookieJar1 :  CookieJar;
  47.     cookiePtr : POINTER TO CookieJar;
  48.     cookieAdr :ADDRESS;
  49.     actRow    : LONGCARD;
  50. BEGIN
  51.    SuperOn;
  52.    cookiePtr:=VAL(ADDRESS,05A0H);
  53.    cookieJar:=cookiePtr^;
  54.    SuperOff;
  55.    actRow:=0D;
  56.    IF cookieJar # NIL THEN
  57.      cookieAdr:=cookieJar;
  58.      WHILE  cookieJar^.CookieId[0]#0C DO
  59.            INC(actRow);
  60.            cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  61.            cookieJar:=cookieAdr;
  62.      END(*WHILE*);
  63.      IF actRow<cookieJar^.CookieValue THEN
  64.            cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  65.            cookieJar1:=cookieAdr;
  66.            cookieJar1^:=cookieJar^;
  67.            cookieJar^:=Entry;
  68.      END(*IF*);
  69.    END(*IF*);
  70.    RETURN FALSE
  71. END NewCookie;
  72.  
  73. PROCEDURE GetCookie(VAR cookie:Cookie):BOOLEAN;
  74. (* fragt den Wert eines Cookies ab.
  75.    Als Parameter wird dabei die ID des zu suchenden Cookies
  76.    übergeben.
  77.    die Routine liefert FALSE wenn der Cookie nicht
  78.    gefunden wurde; wenn er gefunden wurde
  79.    wird TRUE zurückgegeben und der Wert des Cookies
  80.    in cookie.CookieValue eingetragen *)
  81.  
  82. TYPE CookieJar = POINTER TO Cookie;
  83. VAR cookieJar :  CookieJar;
  84.     cookiePtr : POINTER TO CookieJar;
  85.     cookieAdr :ADDRESS;
  86. BEGIN
  87.    SuperOn;
  88.    cookiePtr:=VAL(ADDRESS,05A0H);
  89.    cookieJar:=cookiePtr^;
  90.    SuperOff;
  91.    IF cookieJar # NIL THEN
  92.    cookieAdr:=cookieJar;
  93.       WHILE ~ccmp(cookieJar^,cookie)
  94.            AND ( cookieJar^.CookieId[0]#0C) DO
  95.            cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  96.            cookieJar:=cookieAdr;
  97.       END(*WHILE*);
  98.       IF  cookieJar^.CookieId[0]#0C THEN
  99.           cookie:=cookieJar^; RETURN TRUE
  100.       END(*IF*);
  101.    END(*IF*);
  102.    RETURN FALSE
  103. END GetCookie;
  104.  
  105. PROCEDURE RemoveCookie(VAR id : ARRAY OF CHAR);
  106. (* entfernt den mit id bezeichneten Cookie aus dem CookieJar*)
  107. TYPE CookieJar = POINTER TO Cookie;
  108. VAR cookieJar,
  109.     cookieJar1 :  CookieJar;
  110.     cookiePtr : POINTER TO CookieJar;
  111.     cookieAdr :ADDRESS;
  112.     cookie : Cookie;
  113. BEGIN
  114.    CreateCookie(cookie,id,0D);
  115.    SuperOn;
  116.    cookiePtr:=VAL(ADDRESS,05A0H);
  117.    cookieJar:=cookiePtr^;
  118.    SuperOff;
  119.    IF cookieJar # NIL THEN
  120.    cookieAdr:=cookieJar;
  121.       WHILE ~ccmp(cookieJar^,cookie)
  122.            AND  (cookieJar^.CookieId[0]#0C) DO
  123.            cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  124.            cookieJar:=cookieAdr;
  125.       END(*WHILE*);
  126.       WHILE cookieJar^.CookieId[0]#0C DO
  127.             cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  128.             cookieJar1:=cookieAdr;
  129.             cookieJar^:=cookieJar1^;
  130.             cookieJar:=cookieAdr;
  131.       END(*WHILE*);
  132.    END(*IF*);
  133. END RemoveCookie;
  134.  
  135. PROCEDURE MoveCookieJar(Destination : ADDRESS; size :LONGCARD);
  136. (* verschiebt Kompletten CookieJar an eine neue Speicherstelle.
  137.    Als Parameter werden die neue ADDRESSe des Jars sowie seine Grösse
  138.    d.h. die Anzahl der in ihn hineinpassenden Cookies übergeben *)
  139. TYPE CookieJar = POINTER TO Cookie;
  140. VAR cookieJar,
  141.     NewCookieJar :  CookieJar;
  142.     cookiePtr(*,NewCookiePtr*) : POINTER TO CookieJar;
  143.     cookieAdr,NewCookieAdr :ADDRESS;
  144.  
  145. BEGIN
  146.    SuperOn;
  147.    cookiePtr:=VAL(ADDRESS,05A0H);
  148.    cookieJar:=cookiePtr^;
  149.    SuperOff;
  150.    NewCookieJar:=Destination;
  151.    IF cookieJar # NIL THEN
  152.    cookieAdr:=cookieJar;
  153.       WHILE cookieJar^.CookieId[0]#0C DO
  154.          NewCookieJar^:=cookieJar^;
  155.          cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  156.          cookieJar:=cookieAdr;
  157.          NewCookieAdr:=NewCookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  158.          NewCookieJar:=NewCookieAdr;
  159.       END(*WHILE*);
  160.       NewCookieJar^.CookieId:=cookieJar^.CookieId;
  161.       NewCookieJar^.CookieValue:=size;
  162.  
  163.       SuperOn;
  164.       cookiePtr:=VAL(ADDRESS,05A0H);
  165.       cookiePtr:=Destination;
  166.       SuperOff;
  167.  
  168.    END(*IF*);
  169. END MoveCookieJar;
  170.  
  171. PROCEDURE CookieSize():LONGCARD;
  172. TYPE CookieJar = POINTER TO Cookie;
  173. VAR cookieJar :  CookieJar;
  174.     cookiePtr : POINTER TO CookieJar;
  175.     cookieAdr :ADDRESS;
  176. BEGIN
  177.    SuperOn;
  178.    cookiePtr:=VAL(ADDRESS,05A0H);
  179.    cookieJar:=cookiePtr^;
  180.    SuperOff;
  181.    IF cookieJar # NIL THEN
  182.    cookieAdr:=cookieJar;
  183.       WHILE cookieJar^.CookieId[0]#0C DO
  184.          cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  185.          cookieJar:=cookieAdr;
  186.       END(*WHILE*);
  187.       RETURN (cookieJar^.CookieValue);
  188.    END(*IF*);
  189.    RETURN 0D;
  190. END CookieSize;
  191.  
  192. PROCEDURE PrintCookieJar;
  193. TYPE CookieJar = POINTER TO Cookie;
  194. VAR cookieJar :  CookieJar;
  195.     cookiePtr : POINTER TO CookieJar;
  196.     cookieAdr :ADDRESS;
  197. BEGIN
  198.    SuperOn;
  199.    (* Zeiger auf CookieJar holen *)
  200.    cookiePtr:=VAL(ADDRESS,05A0H);
  201.    cookieJar:=cookiePtr^;
  202.    SuperOff;
  203.    (* Ist der CookieJar überhaupt vorhanden? *)
  204.    IF cookieJar # NIL THEN
  205.    cookieAdr:=cookieJar;
  206.       WHILE cookieJar^.CookieId[0]#0C DO
  207.          WriteString(cookieJar^.CookieId);
  208.          WriteLongCard(cookieJar^.CookieValue,10);
  209.          WriteLn;
  210.          cookieAdr:=cookieAdr+VAL(ADDRESS,TSIZE(Cookie));
  211.          cookieJar:=cookieAdr;
  212.       END(*WHILE*);
  213.       WriteString('Größe');
  214.       WriteLongCard(cookieJar^.CookieValue,10);
  215.    END(*IF*);
  216. END PrintCookieJar;
  217.  
  218. END CookieJar.
  219.